home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
pctjoc85.arc
/
FILECOPY.F77
< prev
next >
Wrap
Text File
|
1985-03-24
|
2KB
|
88 lines
program filecopy
integer*4 n
integer*4 buffer (256)
integer*4 words, iter, bytes
write (*, 1)
1 format (' iterations, record length: ' )
read (*, *) iter, bytes
do 10 n = 1, 256
10 buffer (n) = n
words = bytes/4
call make file ('A:FILE.IN', buffer, words)
call make file ('A:FILE.OUT', buffer, words)
call doit (buffer, words, iter)
stop
end
subroutine doit (buffer, size, iter)
integer*4 size, buffer (size), iter
integer*4 i, in, out
integer*4 n
integer*4 bytes, records
integer*4 recnr, ioerr
integer*2 e (4), s (4)
bytes = size*4
records = 32768 / bytes
in = 1
out = 2
call time (s)
do 50 i = 1, iter
open (in, file = 'A:FILE.IN',
1 access = 'DIRECT', recl = bytes,
1 status = 'OLD', form = 'UNFORMATTED')
open (out, file = 'A:FILE.OUT',
1 access = 'DIRECT', recl = bytes,
1 status = 'OLD', form = 'UNFORMATTED')
n = 0
do 30 recnr = 1, records
read (in, rec = recnr) buffer
write (out, rec = recnr) buffer
n = n + bytes
30 continue
40 close (in)
close (out)
50 continue
write (*, 60) recnr - 1, n
60 format (' done - ', I6, ' records ', I6, ' bytes')
call etime (e, s, iter)
return
100 write (*, 101) ioerr, recnr, n
101 format (' *** read error ', 3I6, ' ***')
stop
200 write (*, 201) n, i, bytes
201 format ('*** write error record', I6, ' of', I6, I6, ' bytes')
stop
end
subroutine make file (file, buffer, size)
character*(*) file
integer*4 size, buffer (size)
integer*4 records, out
integer*4 n, io status
integer*4 bytes
bytes = size*4
out = 2
open (out, file = file, status = 'NEW',
1 access = 'DIRECT', recl = bytes,
1 form = 'UNFORMATTED')
records = 32768 / bytes
write (*, 15)records, bytes
15 format (' ', I8, ' records of ', I4, ' bytes')
do 20 n = 1, records
20 write (out, rec = n) buffer
close (out)
return
end